;;##########################################################################
;; dataslot.lsp
;; Copyright (c) 1991-2002 by Forrest W. Young
;;define slot-accessor methods for the multivariate data-object
;;##########################################################################


(defmeth mv-data-object-proto :icon ()
  (select (send *workmap* :data-icon-list) (1- (send self :icon-number))))

(defmeth mv-data-object-proto :dataflow-path (&optional (str nil set))
"Message args: (&optional logical)
 Sets or retrieves the data flow path."
  (unless (send self :has-slot 'data-flow-path)
          (send self :add-slot 'data-flow-path))
  (if set (setf (slot-value 'data-flow-path) str))
  (slot-value 'data-flow-path)) 

(defmeth mv-data-object-proto :data-flow-path (&optional (str nil set))
"Message args: (&optional logical)
 Sets or retrieves the data flow path."
  (unless (send self :has-slot 'data-flow-path)
          (send self :add-slot 'data-flow-path))
  (if set (setf (slot-value 'data-flow-path) str))
  (slot-value 'data-flow-path)) 

(defmeth mv-data-object-proto :elapsed-time (&optional (real-time nil set))
"Message args: (&optional logical)
 Sets or retrieves the time elapsed since last set."
  (if set (setf (slot-value 'elapsed-time) real-time))
  (slot-value 'elapsed-time))

(defmeth mv-data-object-proto :instance-info (&optional (str nil set))
"Message args: (&optional logical)
 Sets or retrieves information about the object instance.."
  (if set (setf (slot-value 'instance-info) str))
  (slot-value 'instance-info))

(defmeth  mv-data-object-proto :$ (&optional (str nil set))
    (if set (setf (slot-value '$)  str))
    (slot-value '$))

(defmeth mv-data-object-proto :icon-title (&optional (objid nil set))
"Message args: (&optional logical)
 Sets or retrieves data icon title."
  (if set (setf (slot-value 'icon-title) objid))
  (slot-value 'icon-title))

(defmeth mv-data-object-proto :statobj-start-time (&optional (time nil set))
"Message args: (&optional logical)
 Sets or retrieves the start-time for this module. Used to calculate elapsed time."
  (if set (setf (slot-value 'statobj-start-time) time))
  (slot-value 'statobj-start-time))

(defmeth mv-data-object-proto :dash-icon (&optional (objid nil set))
"Message args: (&optional logical)
 Sets or retrieves datasheet icon object id, if any."
  (if set (setf (slot-value 'dash-icon) objid))
  (slot-value 'dash-icon))

(defmeth mv-data-object-proto :new-data (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether the datatype should be new-data."
  (if set (setf (slot-value 'new-data) logical))
  (slot-value 'new-data))

(defmeth mv-data-object-proto :datafile (&optional (string nil set))
"Message args: (&optional string)
 Sets or retrieves the datafile for the data, if any."
  (if set (setf (slot-value 'datafile) string))
  (slot-value 'datafile))

(defmeth mv-data-object-proto :possible-vis-types (&optional (alist nil set))
"Message args: (&optional logical)
 Sets or retrieves the list of possible-vis-types, if any. Returns nil if none."
  (if set (setf (slot-value 'possible-vis-types) alist))
  (slot-value 'possible-vis-types))

(defmeth mv-data-object-proto :subordinate (&optional (object-id nil set))
"Message args: (&optional logical)
 Sets or retrieves the object id of a subordinate data object, if any. Returns nil if none."
  (if set (setf (slot-value 'subordinate) object-id ))
  (slot-value 'subordinate))

(defmeth mv-data-object-proto :bind-variables (&optional (logi nil set))
"Message args: (&optional logical)
 Sets or retrieves whether variable values have been bound to variable name-symbols in the global environment."
  (if set (setf (slot-value 'bind-variables) logi))
  (slot-value 'bind-variables))

(defmeth mv-data-object-proto :emulated-table-obj (&optional (objid nil set))
"Message args: (&optional data-list)
 Sets or retrieves the emulated table data object, if any.."
  (if set (setf (slot-value 'emulated-table-obj) objid))
  (slot-value 'emulated-table-obj))

(defmeth mv-data-object-proto :data (&optional (data nil set))
"Message args: (&optional data-list)
 Sets or retrieves the multivariate data as a list."
  (if set (setf (slot-value 'data) data))
  (slot-value 'data))

(defmeth mv-data-object-proto :title (&optional (title nil set))
"Message args: (&optional title)
 Sets or retrieves the title of the multivariate data."
  (if set (setf (slot-value 'title) title))
  (slot-value 'title))

(defmeth mv-data-object-proto :freq (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether the data are frequencies."
  (if set (setf (slot-value 'freq) logical))
  (slot-value 'freq))

(defmeth mv-data-object-proto :iconify (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether the data are frequencies."
  (if set (setf (slot-value 'iconify) logical))
  (slot-value 'iconify))

(defmeth mv-data-object-proto :missing-values (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether the data have missing values."
  (if set (setf (slot-value 'missing-values) logical))
  (slot-value 'missing-values))

(defmeth mv-data-object-proto :freq-way-names (&optional (list nil set))
"Message args: (&optional list)
 Sets or retrieves the title of the multivariate data."
  (if set (setf (slot-value 'freq-way-names) list))
  (slot-value 'freq-way-names))

(defmeth mv-data-object-proto :about (&optional (about nil set))
"Message args: (&optional about)
 Sets or retrieves the about information of the data."
  (if set (setf (slot-value 'about) about))
  (slot-value 'about))

(defmeth mv-data-object-proto :nobs (&optional (number nil set))
"Message args: (&optional number)
 Sets or retrieves the number of observations in the multivariate data."
  (if set (setf (slot-value 'nobs) number))
  (slot-value 'nobs))

(defmeth mv-data-object-proto :nvar (&optional (number nil set))
"Message args: (&optional number)
 Sets or retrieves the number of variables in the multivariate data."
  (if set (setf (slot-value 'nvar) number))
  (slot-value 'nvar))

(defmeth mv-data-object-proto :matrices  (&optional (names nil set))
"Message args: (&optional strings)
 Sets or retrieves the names of matrices in dissimilarity data."
  (if set (setf (slot-value 'mnames) names))
  (slot-value 'mnames))

(defmeth mv-data-object-proto :active-matrices (ok-types)
"Message args: (&optional strings)
Sets or retrieves the names of active ok-type matrices in dissimilarity data.
An active matrix is one which is selected in the mat-window, or if none 
selected, which is visible in the window.  Ok-types must be one of the 
following strings: all, symmetric, asymmetric, rectangular."
  (select (send self :matrices) (current-matrices ok-types)))

(defmeth mv-data-object-proto :var-window (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves a logical value indicating if the var-window is open."
  (if set (setf (slot-value 'var-window) logical))
  (slot-value 'var-window))

(defmeth mv-data-object-proto :obs-window (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves a logical value indicating if the obs-window is open."
  (if set (setf (slot-value 'obs-window) logical))
  (slot-value 'obs-window))

(defmeth mv-data-object-proto :var-window-object (&optional (object nil set))
"Message args: (&optional logical)
 Sets or retrieves the var-window object identification information."
  (if set (setf (slot-value 'var-window-object) object))
  (slot-value 'var-window-object))

(defmeth mv-data-object-proto :obs-window-object (&optional (object nil set))
"Message args: (&optional logical)
 Sets or retrieves the obs-window object identification information." 
  (if set (setf (slot-value 'obs-window-object) object))
  (slot-value 'obs-window-object))


(defmeth mv-data-object-proto :summary-option-states (&optional (list nil set))
"Message args: (&optional list)
 Sets or retrieves the states of the data-object statistical summary options." 
  (if set (setf (slot-value 'summary-options) list))
  (slot-value 'summary-options))

(defmeth mv-data-object-proto :visualize-option-states (&optional (list nil set))
"Message args: (&optional list)
 Sets or retrieves the visualization options of the data object." 
  (if set (setf (slot-value 'visualize-options) list))
  (slot-value 'visualize-options))


(defmeth mv-data-object-proto :$variables (&optional (names nil set))
"Message args: (&optional strings)
Sets or retrieves variable symbols."
  (if set (setf (slot-value '$variables) names))
  (slot-value '$variables))

(defmeth mv-data-object-proto :variables (&optional (names nil set))
"Message args: (&optional strings)
Sets or retrieves variable name strings."
  (if set (setf (slot-value 'vnames) names))
  (slot-value 'vnames))


(defmeth mv-data-object-proto :labels (&optional (names nil set))
"Message args: (&optional strings)
Sets or retrieves the labels (names) of the observations."
  (if set (setf (slot-value 'onames) names))
  (slot-value 'onames))

(defmeth mv-data-object-proto :active-labels ()
"Message args: none
Reports the labels (names) of the active observations.  Active observations are those which are selected in the obs-window, or if none are selected, which are visible in the window."
  (select (send self :labels) (send self :current-labels)))

(defmeth mv-data-object-proto :types  (&optional (names nil set))
"Message args: (&optional strings)
Sets or retrieves the types of the variables."
  (if set (setf (slot-value 'vtypes) names))
  (slot-value 'vtypes))

(defmeth mv-data-object-proto :array (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether the data also exist as an array."
  (if set (setf (slot-value 'array) logical))
  (slot-value 'array))

(defmeth mv-data-object-proto :array-needs-updating (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether the data array needs updating due to subsetting."
  (if set (setf (slot-value 'array-needs-updating) logical))
  (slot-value 'array-needs-updating))

(defmeth mv-data-object-proto :data-array (&optional (array nil set))
"Message args: (&optional array)
 Sets or retrieves the data as an array when there are category variables." 
  (if set (setf (slot-value 'data-array) array))
  (slot-value 'data-array))

(defmeth mv-data-object-proto :array-labels (&optional (lol nil set))
"Message args: (&optional list-of-lists)
 Sets or retrieves the category level labels as a list-of-lists, one list for each category variable."
  (if set (setf (slot-value 'array-labels) lol))
  (slot-value 'array-labels))

(defmeth mv-data-object-proto :array-variables (&optional (lol nil set))
"Message args: (&optional list)
 Sets or retrieves the list of variable labels."
  (if set (setf (slot-value 'array-variables) lol))
  (slot-value 'array-variables))

(defmeth mv-data-object-proto :freq-array (&optional (array nil set))
"Message args: (&optional array)
 Sets or retrieves the cell observation frequencies as a frequency array when there are category variables."
  (if set (setf (slot-value 'freq-array) array))
  (slot-value 'freq-array))

(defmeth mv-data-object-proto :watcher (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves a logical value indicating if the watcher window is to be used."
  (if set (setf (slot-value 'watcher) logical))
  (slot-value 'watcher))


(defmeth mv-data-object-proto :ways (&optional (string-list nil set))
"Message args: (&optional string-list)
 Sets or retrieves the names of the ways of the table data."
  (if set (setf (slot-value 'ways) string-list))
  (slot-value 'ways))

(defmeth mv-data-object-proto :spreadplot-object 
  (&optional (objid nil set))
"Message args: (&optional objid)
 Sets or retrieves the speadplot object identification for the stat object."
  (if set (setf (slot-value 'spreadplot-object) objid))
  (slot-value 'spreadplot-object))

(defmeth mv-data-object-proto :spreadplots
  (&optional (objid-list nil set))
"Message args: (&optional objid-list)
 Sets or retrieves the list of speadplot object identifications for the stat object."
  (if set (setf (slot-value 'spreadplots) objid-list))
  (slot-value 'spreadplots))

(defmeth mv-data-object-proto :simulate-parameters 
  (&optional (param-list nil set))
"Message args: (&optional param-list)
 Sets or retrieves the list of parameters for simulating data."
  (if set (setf (slot-value 'simulate-parameters) param-list))
  (slot-value 'simulate-parameters))

(defmeth mv-data-object-proto :name (&optional (names nil set))
"Message args: (&optional string)
Sets or retrieves the name of the data object."
  (if set (setf (slot-value 'vmenu)  names))
  (slot-value 'vmenu))

(defmeth mv-data-object-proto :elipsis-name (&optional (names nil set))
"Message args: (&optional string)
Sets or retrieves the elipsis-name of the data object."
  (if set (setf (slot-value 'elipsis-name)  names))
  (slot-value 'elipsis-name))

(defmeth mv-data-object-proto :menu-length (&optional (number nil set))
"Message args: (&optional number)
 Sets or retrieves the position of the object name in the menu."
  (if set (setf (slot-value 'menu-length) number))
  (slot-value 'menu-length))

(defmeth mv-data-object-proto :icon-number (&optional (number nil set))
"Message args: (&optional number)
 Sets or retrieves the icon number (creation order) of the object."
  (if set (setf (slot-value 'icon-number) number))
  (slot-value 'icon-number))

(defmeth mv-data-object-proto :dob-parents  (&optional (object-id-list nil set))
"Message args: (&optional object-id-list)
 Sets or retrieves the list of parent data and model objects." 
  (if set (setf (slot-value 'dob-parents) object-id-list))
  (slot-value 'dob-parents))

(defmeth mv-data-object-proto :dob-children (&optional (object-id-list nil set))
"Message args: (&optional object-id-list)
 Sets or retrieves the list of children data and model objects." 
  (if set (setf (slot-value 'dob-children) object-id-list))
  (slot-value 'dob-children))

(defmeth mv-data-object-proto :guidemap-number (&optional (number nil set))
"Message args: (&optional number)
 Sets or retrieves the guidemap number (just for identification)." 
  (if set (setf (slot-value 'guidemap-number) number))
  (slot-value 'guidemap-number))

(defmeth mv-data-object-proto :statistical-object-type 
   (&optional (string nil set))
"Message args: (&optional string)
Sets or retrieves the type of stat object (data or model)."
  (if set (setf (slot-value 'statistical-object-type) string))
  (slot-value 'statistical-object-type))

(defmeth mv-data-object-proto :statistical-object-type (&optional (logical nil set))
;written this way to prevent changing slot to invalid value
    (setf (slot-value 'statistical-object-type) "data")
    (slot-value 'statistical-object-type))

(defmeth mv-data-object-proto :guidemap-ancestors 
  (&optional (number-list nil set))
"Message args: (&optional number-list)
Sets or retrieves the guidemap ancestors list. This is a list of guidemap numbers created by link and used by return to traverse the guidemap hypertext." 
  (if set (setf (slot-value 'guidemap-ancestors) number-list))
  (slot-value 'guidemap-ancestors))

(defmeth mv-data-object-proto :add-parent (parent-object)
  (send self :dob-parents 
      (add-element-to-list (send self :dob-parents) parent-object)))

(defmeth mv-data-object-proto :add-child (child-object)
  (send self :dob-children 
        (add-element-to-list (send self :dob-children) child-object)))

(defmeth mv-data-object-proto :needs-computing (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether the object needs computing (t) or not (nil)." 
  (if set (setf (slot-value 'needs-computing) logical))
  (slot-value 'needs-computing))

(defmeth mv-data-object-proto :auto-compute (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether the object automatically re-computes (t) or not (nil) when needs-computing is set to t." 
  (if set (setf (slot-value 'auto-compute) logical))
  (slot-value 'auto-compute))

(defmeth mv-data-object-proto :datasheet-object 
  (&optional (object-id nil set))
"Message args: (&optional object-id)
 Sets or retrieves the object id of the data objects datasheet." 
  (if set (setf (slot-value 'datasheet-object) object-id))
  (slot-value 'datasheet-object))

(defmeth mv-data-object-proto :datasheet 
  (&optional (object-id nil set))
"Message args: (&optional object-id)
 Sets or retrieves the object id of the data objects datasheet." 
  (if set (setf (slot-value 'datasheet-object) object-id))
  (slot-value 'datasheet-object))

(defmeth mv-data-object-proto :datasheet-arguments
  (&optional (list nil set))
"Message args: (&optional list)
 Sets or retrieves the list of datasheet arguments." 
  (if set (setf (slot-value 'datasheet-arguments) list))
  (slot-value 'datasheet-arguments))

(defmeth mv-data-object-proto :datasheet-open 
  (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether the datasheet is open." 
  (if set (setf (slot-value 'datasheet-open) logical))
  (slot-value 'datasheet-open))

(defmeth mv-data-object-proto :datatype (&optional (string nil set))
"Message args: (&optional string)
 Sets or retrieves the data type string: univariate, bivariate, multivariate, category, class, freqclass, crosstabs, table, matrix, new, missing, enabled, reenabled, disabled"
  (if set (setf (slot-value 'data-type) string))
  (slot-value 'data-type))

(defmeth mv-data-object-proto :data-type (&optional (string nil set))
"Message args: (&optional string)
 Sets or retrieves the data type string: univariate, bivariate, multivariate, category, class, freqclass, crosstabs, table, matrix, new, missing, enabled, reenabled, disabled"
  (if set (setf (slot-value 'data-type) string))
  (slot-value 'data-type))


(defmeth mv-data-object-proto :extended-datatype (&optional (string nil set))
"Message args: (&optional string)
 Sets or retrieves the data type string: multivariate, frequency, category, classification, matrix." 
  (if set (setf (slot-value 'extended-data-type) string))
  (slot-value 'extended-data-type))

(defmeth mv-data-object-proto :extended-data-type (&optional (string nil set))
"Message args: (&optional string)
 Sets or retrieves the data type string: multivariate, frequency, category, classification, matrix." 
  (if set (setf (slot-value 'extended-data-type) string))
  (slot-value 'extended-data-type))

(defmeth mv-data-object-proto :extension (&optional (integer nil set))
"Message args: (&optional string)
 Sets or retrieves the statistical object extension number"
  (if set (setf (slot-value 'extension) integer))
  (slot-value 'extension))

(defmeth mv-data-object-proto :data-type-abbrev (&optional (str nil set))
"Message args: (&optional string)
 Sets or retrieves the statistical object data-type extension abbreviation (3 chars)"
  (if set (setf (slot-value 'data-type-abbrev) str))
  (slot-value 'data-type-abbrev))

(defmeth mv-data-object-proto :datatype-abbrev (&optional (str nil set))
"Message args: (&optional string)
 Sets or retrieves the statistical object data-type extension abbreviation (3 chars)"
  (if set (setf (slot-value 'data-type-abbrev) str))
  (slot-value 'data-type-abbrev))

(defmeth mv-data-object-proto :full-name (&optional (string nil set))
"Message args: (&optional string)
Sets or retrieves the full name of the stat object (data or model)."
  (if set (setf (slot-value 'full-name) string))
  (slot-value 'full-name))

(defmeth mv-data-object-proto :known-as-name (&optional (str-list nil set))
"Message args: (&optional logical)
 Sets or retrieves the list of substrings (name ext n) that concatenate into the known-as name (name.ext#n)."
  (if set (setf (slot-value 'known-as-name) str-list))
  (slot-value 'known-as-name))

(defmeth mv-data-object-proto :proper-name (&optional (str-list nil set))
"Message args: (&optional logical)
 Sets or retrieves the proper-name string (name.ext\#n)."
  (unless set
     (unless (slot-value 'proper-name) (slot-value 'proper-name (proper-name self))))
  (if set (setf (slot-value 'proper-name) str-list))
  (slot-value 'proper-name))

(defmeth mv-data-object-proto :edited (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether the data have been edited." 
  (if set (setf (slot-value 'edited) logical))
  (slot-value 'edited))

(defmeth mv-data-object-proto :analyzable (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether the data are analyzable. Not analyzable when editing has introduced missing values." 
  (if set (setf (slot-value 'analyzable) logical))
  (slot-value 'analyzable))

(defmeth mv-data-object-proto :real-datatype (&optional (string nil set))
"Message args: (&optional string)
 Sets or retrieves whether the real data type which was temporarily replaced with missing when new data were added to a data matrix." 
  (if set (setf (slot-value 'real-data-type) string))
  (slot-value 'real-data-type))

(defmeth mv-data-object-proto :real-data-type (&optional (string nil set))
"Message args: (&optional string)
 Sets or retrieves whether the real data type which was temporarily replaced with missing when new data were added to a data matrix." 
  (if set (setf (slot-value 'real-data-type) string))
  (slot-value 'real-data-type))

(defmeth mv-data-object-proto :editable (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether the data are editable. Data are editable when datasheet is  editable (not locked)." 
  (if set (setf (slot-value 'editable) logical))
  (slot-value 'editable))

;used for create-data PV Abril 2003

(defmeth mv-data-object-proto :active-selected-data (ok-types)
"Message args: (ok-types)
Reports, for ok-types variables which are active, the data in list form.
An active variable is one which is selected in the var-window, or if none 
selected, which is visible in the window.  Ok-types must be one of the 
following strings: all, numeric, ordinal, category, label."
  (if (send self :ways) 
      (send self :data) ; for table data
      (combine (send self :active-selected-data-matrix ok-types)) ; for mv data
      ))

(defmeth mv-data-object-proto :active-selected-data-matrix (ok-types)
"Message args: (ok-types)
Reports, for ok-types variables which are active, the data in matrix form.
An active variable is one which is selected in the var-window, or if none 
selected, which is visible in the window.  Ok-types must be one of the 
following strings: all, numeric, ordinal, category, label."
  (select (send self :data-matrix) (send self :current-selected-labels)
          (send self :current-variables ok-types)))
;was in dataslot.lsp


(defmeth mv-data-object-proto :active-selected-labels ()
"Message args: none
Reports the labels (names) of the active observations.  Active observations are those which are selected in the obs-window, or if none are selected, which are visible in the window."
  (select (send self :labels) (send self :current-selected-labels)))

(defmeth mv-data-object-proto :current-selected-labels ()
"Method Args: none
Returns a list of indices of the active observations. Active means their labels are (or were when the window was closed) visible in the observation window, or, if any labels are selected, visible AND selected."
  (let* ((nobs (send self :nobs))
         (states (send self :obs-states))
         (selected-labels
          (which (mapcar #'equal (repeat 'SELECTED nobs) states))))
    (when (equal selected-labels nil)
          (setf selected-labels (which (mapcar #'not (mapcar #'equal
                  (repeat 'INVISIBLE nobs) states)))))
    selected-labels))

